home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / ilisp / ilisp-src.el.z / ilisp-src.el
Encoding:
Text File  |  1998-05-21  |  21.3 KB  |  641 lines
  1. ;;; -*- Mode: Emacs-Lisp -*-
  2.  
  3. ;;; ilisp-src.el --
  4.  
  5. ;;; This file is part of ILISP.
  6. ;;; Version: 5.8
  7. ;;;
  8. ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
  9. ;;;               1993, 1994 Ivan Vasquez
  10. ;;;               1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
  11. ;;;               1996 Marco Antoniotti and Rick Campbell
  12. ;;;
  13. ;;; Other authors' names for which this Copyright notice also holds
  14. ;;; may appear later in this file.
  15. ;;;
  16. ;;; Send mail to 'ilisp-request@naggum.no' to be included in the
  17. ;;; ILISP mailing list. 'ilisp@naggum.no' is the general ILISP
  18. ;;; mailing list were bugs and improvements are discussed.
  19. ;;;
  20. ;;; ILISP is freely redistributable under the terms found in the file
  21. ;;; COPYING.
  22.  
  23.  
  24.  
  25. ;;; See ilisp.el for more information.
  26.  
  27. ;;;%Source file operations
  28. (if (not (boundp 'tags-file-name)) (defvar tags-file-name nil))
  29. (defvar lisp-last-definition nil "Last definition (name type) looked for.")
  30. (defvar lisp-last-file nil "Last used source file.")
  31. (defvar lisp-first-point nil "First point found in last source file.")
  32. (defvar lisp-last-point nil "Last point in last source file.")
  33. (defvar lisp-last-locator nil "Last source locator used.")
  34. (defvar lisp-search nil "Set to T when searching for definitions.")
  35. (defvar lisp-using-tags nil "Set to T when using tags.")
  36.  
  37. ;;;%%lisp-directory
  38. (defvar lisp-edit-files t
  39.   "If T, then buffers in one of lisp-source-modes will be searched by
  40. edit-definitions-lisp if the source cannot be found through the
  41. inferior LISP.  It can also be a list of files to edit definitions
  42. from set up by \(\\[lisp-directory]).  If it is set to nil, then no
  43. additional files will be searched.")
  44.  
  45. ;;;
  46. (defun lisp-extensions ()
  47.   "Return a regexp for matching the extensions of files that enter one
  48. of lisp-source-modes according to auto-mode-alist."
  49.   (let ((entries auto-mode-alist)
  50.     (extensions nil))
  51.     (while entries
  52.       (let ((entry (car entries)))
  53.     (if (memq (cdr entry) lisp-source-modes)
  54.         (setq extensions 
  55.           (concat "\\|" (car entry) extensions))))
  56.       (setq entries (cdr entries)))
  57.   (substring extensions 2)))
  58.  
  59. ;;;
  60. (defun lisp-directory (directory add)
  61.   "Edit the files in DIRECTORY that have an auto-mode alist entry in
  62. lisp-source-modes.  With a positive prefix, add the files on to the
  63. already existing files.  With a negative prefix, clear the list.  In
  64. either case set tags-file-name to nil so that tags are not used."
  65.   (interactive 
  66.    (list (if (not (eq current-prefix-arg '-))
  67.          (read-file-name "Lisp Directory: "
  68.                  nil
  69.                  default-directory
  70.                  nil))
  71.          current-prefix-arg))
  72.   (setq tags-file-name nil)
  73.   (if (eq add '-)
  74.       (progn (setq lisp-edit-files t)
  75.          (message "No current lisp directory"))
  76.       (if add
  77.       (message "Added %s as a lisp directory" directory)
  78.       (message "%s is the lisp directory" directory))
  79.       (setq directory (expand-file-name directory))
  80.       (if (file-directory-p directory)
  81.       (setq lisp-edit-files
  82.         (append
  83.          (directory-files directory t (lisp-extensions))
  84.          (if add (if (eq lisp-edit-files t) nil lisp-edit-files))))
  85.       (error "%s is not a directory" directory))))
  86.  
  87. ;;;%%Utilities
  88.  
  89. (defun fix-source-filenames ()
  90.   "Apply the ilisp-source-directory-fixup-alist to the current buffer
  91.    (which will be *Edit-Definitions*) to change any pre-compiled
  92.    source-file locations to point to local source file locations.  
  93.    See ilisp-source-directory-fixup-alist."
  94.   (let ((alist (ilisp-value 'ilisp-source-directory-fixup-alist t))
  95.     cons)
  96.     (if alist
  97.     (save-excursion
  98.       (while alist
  99.         (setq cons (car alist))
  100.         (goto-char (point-min))
  101.         (if (re-search-forward (car cons) (point-max) t)
  102.         (replace-match (cdr cons)))
  103.         (setq alist (cdr alist)))))))
  104.  
  105. (defun lisp-setup-edit-definitions (message edit-files)
  106.   "Set up *Edit-Definitions* with MESSAGE. If EDIT-FILES is T, insert
  107. all buffer filenames that are in one of lisp-source-modes into the
  108. current buffer.  If it is a list of files set up by lisp-directory,
  109. insert those in the buffer.  If it is a string put that in the buffer."
  110.   (setq lisp-using-tags nil
  111.     lisp-search (not (stringp edit-files)))
  112.   (set-buffer (get-buffer-create "*Edit-Definitions*"))
  113.   (erase-buffer)
  114.   (insert message)
  115.   (insert "\n\n")
  116.   (if edit-files
  117.       (progn
  118.     (if (eq edit-files t)
  119.         (let ((buffers (buffer-list)))
  120.           (while buffers
  121.         (let ((buffer (car buffers)))
  122.           (if (save-excursion 
  123.             (set-buffer buffer) 
  124.             (and (memq major-mode lisp-source-modes)
  125.                  (buffer-file-name buffer)))
  126.               (progn (insert ?\") (insert (buffer-file-name buffer))
  127.                  (insert "\"\n"))))
  128.         (setq buffers (cdr buffers))))
  129.         (if (stringp edit-files)
  130.         (progn (insert edit-files)
  131.                    ;; Remove garbage collection messages
  132.                (replace-regexp "^;[^\n]*\n" "")
  133.                (fix-source-filenames))
  134.         (let ((files edit-files))
  135.           (while files
  136.             (insert ?\")
  137.             (insert (car files))
  138.             (insert "\"\n")
  139.             (setq files (cdr files))))))
  140.     (goto-char (point-min))
  141.     (forward-line 2)
  142.     (set-buffer-modified-p nil))
  143.       (error 
  144.        (substitute-command-keys
  145.     "Use \\[lisp-directory] to define source files."))))
  146.       
  147. ;;;
  148. (defun lisp-locate-definition (locator definition file point 
  149.                        &optional
  150.                        back pop)
  151.   "Use LOCATOR to find the next DEFINITION (symbol . type) in FILE
  152. starting at POINT, optionally BACKWARDS and POP to buffer.  Return T
  153. if successful."
  154.   (if file 
  155.       (if (not (file-exists-p file))
  156.       (progn
  157.         (message "File %s doesn't exist!" file)
  158.         (sit-for 1)
  159.         nil)
  160.       (let* ((symbol (car definition))
  161.          (type (cdr definition))
  162.          (first (not (eq lisp-last-file file)))
  163.          (buffer (current-buffer))
  164.          name)
  165.         (lisp-find-file file pop)
  166.         (if first (setq lisp-first-point (point)))
  167.         (if back
  168.         (if first
  169.             (goto-char (point-max))
  170.             (goto-char point)
  171.             (forward-line -1) 
  172.             (end-of-line))
  173.         (goto-char point)
  174.         (if (not first) 
  175.             (progn (forward-line 1) (beginning-of-line))))
  176.         (if (eq type 't)
  177.         (message "Search %s for %s" file symbol)
  178.         (message "Searching %s for %s %s" file type
  179.              (setq name (lisp-buffer-symbol symbol))))
  180.         (if (funcall locator symbol type first back)
  181.         (progn
  182.           (setq lisp-last-file file
  183.             lisp-last-point (point))
  184.           (if (bolp)
  185.               (forward-line -1)
  186.               (beginning-of-line))
  187.           (recenter 0)
  188.           (if name 
  189.               (message "Found %s %s definition" type name)
  190.               (message "Found %s"))
  191.           t)
  192.         (if first 
  193.             (goto-char lisp-first-point)
  194.             (set-buffer buffer)
  195.             (goto-char point))
  196.         nil)))))
  197.  
  198. ;;;
  199. (defun lisp-next-file (back)
  200.   "Return the next filename in *Edit-Definitions*, or nil if none."
  201.   (let ((file t) 
  202.     result)
  203.     (set-buffer (get-buffer-create "*Edit-Definitions*"))
  204.     (if back 
  205.     (progn (forward-line -1)
  206.            (if (looking-at "\n")
  207.            (progn 
  208.              (forward-line 1)
  209.              (end-of-line)
  210.              (setq file nil)))))
  211.   (if file
  212.       (progn
  213.     (skip-chars-forward "^\"")
  214.     (if (eobp)
  215.         (progn (bury-buffer (current-buffer))
  216.            (setq result nil))
  217.         (let* ((start (progn (forward-char 1) (point))))
  218.           (skip-chars-forward "^\"") 
  219.           (setq file
  220.             (prog1 (buffer-substring start (point))
  221.               (end-of-line)))
  222.           (bury-buffer (current-buffer))))))
  223.   (if (not (eq file 't)) file)))
  224.  
  225. ;;;
  226. (defun lisp-next-definition (back pop)
  227.   "Go to the next definition from *Edit-Definitions* going BACK with
  228. prefix and POPPING.  Return 'first if found first time, 'none if no
  229. definition ever, T if another definition is found, and nil if no more
  230. definitions are found."
  231.   (let ((done nil)
  232.     (result nil))
  233.     (while
  234.     (not
  235.      (or
  236.       (setq result
  237.         (lisp-locate-definition    ;Same file
  238.          lisp-last-locator
  239.          lisp-last-definition lisp-last-file lisp-last-point back))
  240.       (let ((file (lisp-next-file back)))
  241.         (if file
  242.         (if (lisp-locate-definition 
  243.              lisp-last-locator lisp-last-definition 
  244.              file 1 back 
  245.              (prog1 pop (setq pop nil)))
  246.             (setq result 'first)
  247.             (setq result (if (not lisp-search) 'none)))
  248.         t)))))
  249.     (set-buffer (window-buffer (selected-window)))
  250.     result))
  251.  
  252. ;;;%%Next-definition
  253. (defun next-definition-lisp (back &optional pop)
  254.   "Edit the next definition from *Edit-Definitions* going BACK with
  255. prefix and optionally POPPING or call tags-loop-continue if using tags."
  256.   (interactive "P")
  257.   (if lisp-using-tags
  258.       (tags-loop-continue)
  259.       (let* ((result (lisp-next-definition back pop))
  260.          (symbol (car lisp-last-definition))
  261.          (type (cdr lisp-last-definition))
  262.          (name (if (not (eq type 't)) (lisp-buffer-symbol symbol))))
  263.     (cond ((or (eq result 'first) (eq result 't))
  264.            (if name
  265.            (message "Found %s %s definition" type name)
  266.            (message "Found %s" symbol)))
  267.           ((eq result 'none)
  268.            (error "Can't find %s %s definition" type name))
  269.           (t 
  270.            (if name 
  271.            (error "No more %s %s definitions" type name)
  272.            (message "Done")))))))
  273.  
  274.  
  275. ;;;%%Edit-definitions
  276. (defun edit-definitions-lisp (symbol type &optional stay search locator)
  277.   "Find the source files for the TYPE definitions of SYMBOL.  If STAY,
  278. use the same window.  If SEARCH, do not look for symbol in inferior
  279. LISP.  The definition will be searched for through the inferior LISP
  280. and if not found it will be searched for in the current tags file and
  281. if not found in the files in lisp-edit-files set up by
  282. \(\\[lisp-directory]) or the buffers in one of lisp-source-modes if
  283. lisp-edit-files is T.  If lisp-edit-files is nil, no search will be
  284. done if not found through the inferior LISP.  TYPES are from
  285. ilisp-source-types which is an alist of symbol strings or list
  286. strings.  With a negative prefix, look for the current symbol as the
  287. first type in ilisp-source-types."
  288.   (interactive 
  289.    (let* ((types (ilisp-value 'ilisp-source-types t))
  290.       (default (if types (car (car types))))
  291.       (function (lisp-function-name))
  292.       (symbol (lisp-buffer-symbol function)))
  293.      (if (lisp-minus-prefix)
  294.      (list function default)
  295.      (list (ilisp-read-symbol 
  296.         (format "Edit Definition [%s]: " symbol)
  297.         function
  298.         nil
  299.         t)
  300.            (if types 
  301.            (ilisp-completing-read
  302.             (format "Type [%s]: " default)
  303.             types default))))))
  304.   (let* ((name (lisp-buffer-symbol symbol))
  305.      (symbol-name (lisp-symbol-name symbol))
  306.      (command (ilisp-value 'ilisp-find-source-command t))
  307.      (source
  308.       (if (and command (not search) (comint-check-proc ilisp-buffer))
  309.           (ilisp-send
  310.            (format command symbol-name
  311.                (lisp-symbol-package symbol)
  312.                type)
  313.            (concat "Finding " type " " name " definitions")
  314.            'source )
  315.           "nil"))
  316.      (result (and source (lisp-last-line source)))
  317.      (source-ok (not (or (ilisp-value 'comint-errorp t)
  318.                  (null result)
  319.                  (string-match "nil" (car result)))))
  320.      (case-fold-search t)
  321.      (tagged nil))
  322.     (unwind-protect
  323.        (if (and tags-file-name (not source-ok))
  324.        (progn (setq lisp-using-tags t)
  325.           (if (string-match "Lucid" emacs-version)
  326.               (find-tag symbol-name stay)
  327.               (find-tag symbol-name nil stay))
  328.           (setq tagged t)))
  329.        (if (not tagged)
  330.        (progn
  331.          (setq lisp-last-definition (cons symbol type)
  332.            lisp-last-file nil
  333.            lisp-last-locator (or locator (ilisp-value 'ilisp-locator)))
  334.          (lisp-setup-edit-definitions
  335.           (format "%s %s definitions:" type name)
  336.           (if source-ok (cdr result) lisp-edit-files))
  337.          (next-definition-lisp nil t))))))
  338.  
  339. ;;;%%Searching
  340. (defun lisp-locate-search (pattern type first back)
  341.   "Find PATTERN in the current buffer."
  342.   (if back
  343.       (search-backward pattern nil t)
  344.       (search-forward pattern nil t)))
  345.  
  346. ;;;
  347. (defun lisp-locate-regexp (regexp type first back)
  348.   "Find REGEXP in the current buffer."
  349.   (if back
  350.       (re-search-backward regexp nil t)
  351.       (re-search-forward regexp nil t)))
  352.  
  353. ;;;
  354. (defvar lisp-last-pattern nil "Last search regexp.")
  355. (defun search-lisp (pattern regexp)
  356.   "Search for PATTERN through the files in lisp-edit-files if it is a
  357. list and the current buffers in one of lisp-source-modes otherwise.
  358. If lisp-edit-files is nil, no search will be done.  If called with a
  359. prefix, search for regexp.  If there is a tags file, call tags-search instead."
  360.   (interactive
  361.    (list (read-string (if current-prefix-arg 
  362.               "Search for regexp: "
  363.               "Search for: ") lisp-last-pattern)
  364.      current-prefix-arg))
  365.   (if tags-file-name
  366.       (progn (setq lisp-using-tags t)
  367.          (tags-search (if regexp pattern (regexp-quote pattern))))
  368.       (setq lisp-last-pattern pattern
  369.         lisp-last-definition (cons pattern t)
  370.         lisp-last-file nil
  371.         lisp-last-locator (if regexp
  372.                   'lisp-locate-regexp
  373.                   'lisp-locate-search))
  374.       (lisp-setup-edit-definitions (format "Searching for %s:" pattern) 
  375.                    lisp-edit-files)
  376.       (next-definition-lisp nil nil)))
  377.  
  378. ;;;%%Replacing
  379. (defvar lisp-last-replace nil "Last replace regexp.")
  380. (defun replace-lisp (old new regexp)
  381.   "Query replace OLD by NEW through the files in lisp-edit-files if it
  382. is a list and the current buffers in one of lisp-source-modes
  383. otherwise.  If lisp-edit-files is nil, no search will be done.  If
  384. called with a prefix, replace regexps.  If there is a tags file, then
  385. call tags-query-replace instead."
  386.   (interactive
  387.    (let ((old (read-string (if current-prefix-arg
  388.                    "Replace regexp: "
  389.                    "Replace: ") lisp-last-pattern)))
  390.      (list old
  391.        (read-string (if current-prefix-arg
  392.                 (format "Replace regexp %s by: " old)
  393.                 (format "Replace %s by: " old))
  394.             lisp-last-replace)
  395.        current-prefix-arg)))
  396.   (if tags-file-name
  397.       (progn (setq lisp-using-tags t)
  398.          (tags-query-replace (if regexp old (regexp-quote old))
  399.                  new))
  400.       (setq lisp-last-pattern old
  401.         lisp-last-replace new)
  402.       (lisp-setup-edit-definitions 
  403.        (format "Replacing %s by %s:\n\n" old new)
  404.        lisp-edit-files)
  405.       (let (file)
  406.     (while (setq file (lisp-next-file nil))
  407.       (lisp-find-file file)
  408.       (let ((point (point)))
  409.         (goto-char (point-min))
  410.         (if (if regexp 
  411.             (re-search-forward old nil t)
  412.             (search-forward old nil t))
  413.         (progn (beginning-of-line)
  414.                (if regexp
  415.                (query-replace-regexp old new)
  416.                (query-replace old new)))
  417.         (goto-char point)))))))
  418.  
  419. ;;;%%Edit-callers
  420. (defvar lisp-callers nil 
  421.   "T if we found callers through inferior LISP.")
  422.  
  423. ;;;
  424. (defun who-calls-lisp (function &optional no-show)
  425.   "Put the functions that call FUNCTION into the buffer *All-Callers*
  426. and show it unless NO-SHOW is T.  Return T if successful."
  427.   (interactive 
  428.    (let* ((function (lisp-defun-name))
  429.       (symbol (lisp-buffer-symbol function)))
  430.      (if (lisp-minus-prefix)
  431.      (list function)
  432.      (list (ilisp-read-symbol 
  433.         (format "Who Calls [%s]: " symbol)
  434.         function
  435.         t t)))))
  436.   (let* ((name (lisp-buffer-symbol function))
  437.      (command (ilisp-value 'ilisp-callers-command t))
  438.      (callers
  439.       (if command
  440.           (ilisp-send
  441.            (format command
  442.                (lisp-symbol-name function)
  443.                (lisp-symbol-package function))
  444.            (concat "Finding callers of " name)
  445.            'callers)))
  446.      (last-line (lisp-last-line callers))
  447.      (case-fold-search t))
  448.     (set-buffer (get-buffer-create "*All-Callers*"))
  449.     (erase-buffer)
  450.     (insert (format "All callers of function %s:\n\n" name))
  451.     (if (and command (not (ilisp-value 'comint-errorp t)))
  452.     (if (string-match "nil" (car last-line))
  453.         (error "%s has no callers" name)
  454.         (message "")
  455.         (insert (cdr last-line))
  456.         (goto-char (point-min))
  457.         ;; Remove garbage collection messages
  458.         (replace-regexp "^;[^\n]*\n" "")
  459.         (goto-char (point-min))
  460.         (forward-line 2)
  461.         (if (not no-show) 
  462.         (if (ilisp-temp-buffer-show-function)
  463.             (funcall (ilisp-temp-buffer-show-function)
  464.                  (get-buffer "*All-Callers*"))
  465.             (view-buffer "*All-Callers*")))
  466.         t)
  467.     (insert "Using the current source files to find callers.")
  468.     nil)))
  469.  
  470. ;;;
  471. (defun next-caller-lisp (back &optional pop)
  472.   "Edit the next caller from *All-Callers*.  With prefix, edit
  473. the previous caller.  If it can't get caller information from the
  474. inferior LISP, this will search using the current source files.  See
  475. lisp-directory."
  476.   (interactive "P")
  477.   (if (not lisp-callers)
  478.       (next-definition-lisp back pop)
  479.       (set-buffer (get-buffer-create "*All-Callers*"))
  480.       (if back (forward-line -1))
  481.       (skip-chars-forward " \t\n")
  482.       (if (eobp)
  483.       (progn
  484.         (bury-buffer (current-buffer))
  485.         (error "No more callers"))
  486.       (let* ((start (point))
  487.          (caller-function
  488.           (progn
  489.             (skip-chars-forward "^ \t\n")
  490.             (buffer-substring start (point)))))
  491.         (bury-buffer (current-buffer))
  492.         (edit-definitions-lisp (lisp-string-to-symbol caller-function) 
  493.                   (car (car (ilisp-value 'ilisp-source-types)))
  494.                   (not pop))))))
  495.  
  496. ;;;
  497. (defun edit-callers-lisp (function)
  498.   "Edit the callers of FUNCTION.  With a minus prefix use the symbol
  499. at the start of the current defun."
  500.   (interactive
  501.    (let* ((function (lisp-defun-name)))
  502.      (if (lisp-minus-prefix)
  503.      (list function)
  504.      (list (ilisp-read-symbol 
  505.         (format "Edit callers of [%s]: "
  506.             (lisp-buffer-symbol function))
  507.         function
  508.         t)))))
  509.   (if (save-excursion (setq lisp-callers (who-calls-lisp function t)))
  510.       (progn 
  511.     (setq lisp-last-locator (ilisp-value 'ilisp-calls-locator))
  512.     (next-caller-lisp nil t))
  513.       (edit-definitions-lisp function "calls" nil t 
  514.                 (ilisp-value 'ilisp-calls-locator))))
  515.  
  516. ;;;%Locators
  517. (defun lisp-re (back format &rest args)
  518.   "Search BACK if T using FORMAT applied to ARGS."
  519.   (let ((regexp (apply 'format format args)))
  520.     (if back
  521.     (re-search-backward regexp nil t)
  522.     (re-search-forward regexp nil t))))
  523.  
  524. ;;;
  525. (defun lisp-locate-ilisp (symbol type first back)
  526.   "Find SYMBOL's TYPE definition in the current file and return T if
  527. successful.  A definition is of the form
  528. \(def<whitespace>(?name<whitespace>."
  529.   (lisp-re back
  530.        "^[ \t\n]*(def[^ \t\n]*[ \t\n]+(?%s[ \t\n(]+" 
  531.        (regexp-quote (lisp-symbol-name symbol))))
  532.  
  533. ;;;
  534. (defun lisp-locate-calls (symbol type first back)
  535.   "Locate calls to SYMBOL."
  536.   (lisp-re back "\\(#'\\|(\\|'\\)%s\\([ \t\n]+\\|)\\)"
  537.        (regexp-quote (lisp-buffer-symbol symbol))))
  538.  
  539.  
  540. ;;;%%Common LISP
  541.  
  542. (defvar ilisp-cl-source-locater-patterns
  543.   '((setf
  544.      "^\\(.\\)?[ \t\n]*(def[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)(setf\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n]*\\(.\\)?[ \t\n]*)")
  545.  
  546.     (function
  547.      "^\\(.\\)?[ \t\n]*(defun\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
  548.  
  549.     (macro
  550.      "^\\(.\\)?[ \t\n]*(defmacro\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
  551.  
  552.     (variable
  553.      "^\\(.\\)?[ \t\n]*(def\\(\\(var\\)\\|\\(parameter\\)\\|constant\\)\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
  554.  
  555.     (structure
  556.      "^\\(.\\)?[ \t\n]*(defstruct\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)(?[ \t\n]*\\(.\\)?[ \t\n]*%s[ \t\n(]")
  557.  
  558.     (type
  559.      "^\\(.\\)?[ \t\n]*(deftype\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
  560.  
  561.     (class
  562.      "^\\(.\\)?[ \t\n]*(defclass\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
  563.     ))
  564.  
  565.  
  566. (defun ilisp-locate-clisp-defn (name type back)
  567.   (let ((pattern (car (cdr (assoc (intern type) ilisp-cl-source-locater-patterns)))))
  568.     (if pattern
  569.     (lisp-re back pattern name))))
  570.  
  571.  
  572.  
  573. (defun ilisp-locate-clos-method (name type back)
  574.   (if (string-match "(\\([^(]*\\)\\(([^)]*)\\)" type)
  575.       (let* ((quals (substring type (match-beginning 1) (match-end 1)))
  576.          (class
  577.           (read (substring type (match-beginning 2) (match-end 2))))
  578.          (class-re nil)
  579.          (position 0))
  580.     (while (setq position (string-match 
  581.                    "\\([ \t\n]+.[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\|[ \t\n]+\\)"
  582.                    quals position))
  583.       (setq quals
  584.         (concat (substring quals 0 position)
  585.             "\\([ \t\n]+.[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\|[ \t\n]+\\)"
  586.             (substring quals (match-end 0)))))
  587.     (while class
  588.       (setq class-re 
  589.         (concat 
  590.          class-re 
  591.          (format
  592.           "[ \t\n]*\\(.\\)?[ \t\n]*([ \t\n]*\\(.\\)?[ \t\n]*[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n]*\\(.\\)?[ \t\n]*"
  593.           (car class)))
  594.         class (cdr class)))
  595.     (lisp-re back 
  596.          "^\\(.\\)?[ \t\n]*(def[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[^ \t\n]*([^ \t\n]*%s"
  597.          name quals class-re))))
  598.  
  599.  
  600.  
  601.  
  602. (defun lisp-locate-clisp (symbol type first back)
  603.   "Try to find SYMBOL's TYPE definition in the current buffer and return
  604. T if sucessful.  FIRST is T if this is the first time in a file.  BACK
  605. is T to go backwards."
  606.   (let* ((name (regexp-quote (lisp-symbol-name symbol)))
  607.      (prefix 
  608.       ;; Automatically generated defstruct accessors
  609.       (if (string-match "-" name)
  610.           (let ((struct (substring name 0 (1- (match-end 0)))))
  611.         (format 
  612.          "^\\(.\\)?[ \t\n]*(def[^ \t\n]*\\([ \t\n]+\\(.\\)?\\|\\|[ \t\n]*.[ \t\n]+\\)(?%s[ \t\n)]\\|:conc-name\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s-" 
  613.          struct struct))))
  614.      ;; Defclass accessors
  615.      (class
  616.       "\\(:accessor\\|:writer\\|:reader\\)\\([ \t\n]+\\(.\\)?+[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n)]"))
  617.     (or
  618.      (if (equal type "any")
  619.      (lisp-re 
  620.       back
  621.       (concat
  622.        "^\\(.\\)?[ \t\n]*(def[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)\\((setf\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)\\|(?[ \t\n]*\\(.\\)?[ \t\n]*\\)%s[ \t\n)]"
  623.        (if prefix (concat "\\|" prefix))
  624.        "\\|"
  625.        class)
  626.       name name))
  627.  
  628.      ;; (qualifiers* (type1 type2 ...))
  629.      (ilisp-locate-clos-method name type back)
  630.  
  631.      (ilisp-locate-clisp-defn name type back)
  632.  
  633.      ;; Standard def form
  634.      (if first (lisp-locate-ilisp symbol type first back))
  635.      ;; Automatically generated defstruct accessors
  636.      (if (and first prefix) (lisp-re back prefix))
  637.      ;; Defclass accessors
  638.      (lisp-re back class name)
  639.      ;; Give up!
  640.      )))
  641.